home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 001 / pibt32s2.arc / PIBFMANI.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1985-10-25  |  33.5 KB  |  857 lines
  1. (*----------------------------------------------------------------------*)
  2. (*        PibFileManipulation --- File Manipulation for Turbo           *)
  3. (*----------------------------------------------------------------------*)
  4.  
  5. OVERLAY PROCEDURE PibFileManipulation;
  6.  
  7. (*----------------------------------------------------------------------*)
  8. (*                                                                      *)
  9. (*     Procedure:  PibFileManipulation                                  *)
  10. (*                                                                      *)
  11. (*     Purpose:    Central control routine for file manipulation        *)
  12. (*                                                                      *)
  13. (*     Calling Sequence:                                                *)
  14. (*                                                                      *)
  15. (*        PibFileManipulation;                                          *)
  16. (*                                                                      *)
  17. (*     Calls:                                                           *)
  18. (*                                                                      *)
  19. (*     Remarks:                                                         *)
  20. (*                                                                      *)
  21. (*        This routine exists to centralize file manipulation so that   *)
  22. (*        the Turbo Pascal overlay scheme will work.                    *)
  23. (*                                                                      *)
  24. (*----------------------------------------------------------------------*)
  25.  
  26. VAR
  27.    File_Menu     : Menu_Type;
  28.    I             : INTEGER;
  29.  
  30. (*----------------------------------------------------------------------*)
  31. (*           Get_File_Size --- Get size in bytes for a file             *)
  32. (*----------------------------------------------------------------------*)
  33.  
  34. FUNCTION Get_File_Size( Fname: AnyStr; VAR OpenOK : BOOLEAN ): REAL;
  35.  
  36. (*----------------------------------------------------------------------*)
  37. (*                                                                      *)
  38. (*     Procedure:  Get_File_Size                                        *)
  39. (*                                                                      *)
  40. (*     Purpose:    Get size in bytes for a file                         *)
  41. (*                                                                      *)
  42. (*     Calling Sequence:                                                *)
  43. (*                                                                      *)
  44. (*        Fsize := Get_File_Size( Fname      : AnyStr;                  *)
  45. (*                                VAR OpenOK : BOOLEAN ) : Real;        *)
  46. (*                                                                      *)
  47. (*           Fname  --- name of file to find size of                    *)
  48. (*           OpenOK --- set TRUE if file opened successfully            *)
  49. (*           Fsize  --- file size in bytes                              *)
  50. (*                                                                      *)
  51. (*     Calls:                                                           *)
  52. (*                                                                      *)
  53. (*        RESET                                                         *)
  54. (*        Int24Result                                                   *)
  55. (*        ASSIGN                                                        *)
  56. (*        LongFileSize                                                  *)
  57. (*        Close                                                         *)
  58. (*                                                                      *)
  59. (*     Remarks:                                                         *)
  60. (*                                                                      *)
  61. (*        The file must not already be opened before calling this       *)
  62. (*        routine.                                                      *)
  63. (*                                                                      *)
  64. (*----------------------------------------------------------------------*)
  65.  
  66. VAR
  67.    F : FILE OF BYTE;
  68.  
  69. BEGIN (* Get_File_Size *)
  70.  
  71.    Get_File_Size := 0.0;
  72.  
  73.    ASSIGN( F , Fname );
  74.    (*$I- *)
  75.    RESET ( F );
  76.    (*$I+ *)
  77.  
  78.    IF Int24Result = 0 THEN
  79.       BEGIN
  80.          Get_File_Size := LongFileSize( F );
  81.          CLOSE( F );
  82.          OpenOK := TRUE;
  83.       END
  84.    ELSE
  85.       OpenOK := FALSE;
  86.  
  87. END   (* Get_File_Size *);
  88.  
  89. (*----------------------------------------------------------------------*)
  90. (*           View_A_File --- List ascii file                            *)
  91. (*----------------------------------------------------------------------*)
  92.  
  93. PROCEDURE View_A_File;
  94.  
  95. (*----------------------------------------------------------------------*)
  96. (*                                                                      *)
  97. (*     Procedure:  View_A_File                                          *)
  98. (*                                                                      *)
  99. (*     Purpose:    Lists selected ascii file                            *)
  100. (*                                                                      *)
  101. (*     Calling Sequence:                                                *)
  102. (*                                                                      *)
  103. (*        View_A_File;                                                  *)
  104. (*                                                                      *)
  105. (*     Calls:   View_Prompt                                             *)
  106. (*              Save_Screen                                             *)
  107. (*              Restore_Screen                                          *)
  108. (*              Draw_Menu_Frame                                         *)
  109. (*              Reset_Global_Colors                                     *)
  110. (*                                                                      *)
  111. (*     Remarks:                                                         *)
  112. (*                                                                      *)
  113. (*        This routine will list non-ascii files, but they will be      *)
  114. (*        meaningless.                                                  *)
  115. (*                                                                      *)
  116. (*----------------------------------------------------------------------*)
  117.  
  118. VAR
  119.    View_File_Name : STRING[15];
  120.    ViewFile       : Text;
  121.    View_File_Open : BOOLEAN;
  122.    View_File_Size : Real;
  123.  
  124. BEGIN (* View_A_File *)
  125.                                    (*  Draw view menu *)
  126.  
  127.    Save_Screen( Saved_Screen );
  128.    Draw_Menu_Frame( 5, 4, 75, 25, Menu_Frame_Color,
  129.                     Menu_Text_Color, 'View A File' );
  130.  
  131.                                    (* Get name of file to list *)
  132.    WRITELN;
  133.    WRITE('Enter name of file to list: ');
  134.    READLN( View_File_Name );
  135.  
  136.    View_File_Open := FALSE;
  137.  
  138.                                    (* Ensure file exists ... *)
  139.    IF LENGTH( View_File_Name ) > 0 THEN
  140.       BEGIN  (* View_File_Name > 0 *)
  141.  
  142.          View_File_Size := Get_File_Size( View_File_Name , View_File_Open );
  143.  
  144.  
  145.          IF ( NOT View_File_Open ) THEN
  146.             BEGIN (* Int24Result <> 0 *)
  147.                TextColor( Menu_Text_Color + Blink );
  148.                WRITELN('>>> Can''t open file ',View_File_Name,' for viewing.');
  149.                DELAY( Two_Second_Delay );
  150.                TextColor( Menu_Text_Color );
  151.             END   (* Int24Result <> 0 *)
  152.  
  153.                                    (* ... and file is not empty *)
  154.  
  155.         ELSE IF ( View_File_Size <= 0  ) THEN
  156.             BEGIN  (* File is empty *)
  157.                TextColor( Menu_Text_Color + Blink );
  158.                WRITELN('>>> File ',View_File_Name,' is empty.');
  159.                DELAY( Two_Second_Delay );
  160.                TextColor( Menu_Text_Color );
  161.             END    (* File is empty *)
  162.  
  163.         ELSE                       (* Write header line         *)
  164.             BEGIN  (* List the File *)
  165.  
  166.                ASSIGN( ViewFile, View_File_Name );
  167.                RESET( ViewFile );
  168.  
  169.                Clear_Window;
  170.  
  171.                RvsVideoOn( Menu_Text_Color , BackGround_Color );
  172.  
  173.                WRITELN('LISTING OF FILE: ',View_File_Name,
  174.                        '        SIZE: ', View_File_Size:8:0, ' BYTES.');
  175.  
  176.                RvsVideoOff( Menu_Text_Color , BackGround_Color );
  177.  
  178.                                    (* RESET window so header doesn't vanish *)
  179.                Window( 7, 6, 74, 24 );
  180.                GoToXY( 1 , WhereY );
  181.  
  182.                                    (* List the file             *)
  183.  
  184.                View_Count := 0;
  185.                View_Done  := FALSE;
  186.  
  187.                REPEAT
  188.                                    (* Read and write line from file *)
  189.                   READLN ( ViewFile , View_Line );
  190.                   IF Length( View_Line ) > 65 THEN View_Line[0] := CHR( 65 );
  191.                   WRITELN( View_Line );
  192.  
  193.                                    (* Increment count of lines displayed *)
  194.                   View_Count := View_Count + 1;
  195.  
  196.                                    (* Prompt if end of screen *)
  197.                   IF View_Count > 17 THEN
  198.                      View_Prompt( View_Done , View_Count );
  199.  
  200.                UNTIL EOF( ViewFile ) OR View_Done;
  201.  
  202.                RvsVideoOn( Menu_Text_Color , BackGround_Color );
  203.                WRITE('Viewing of file complete. ',
  204.                      'Hit any key to continue.');
  205.                RvsVideoOff( Menu_Text_Color , BackGround_Color );
  206.                WHILE ( Not KeyPressed ) DO ;
  207.                READ( Kbd , View_Char[1] );
  208.  
  209.             END  (* List the file *);
  210.  
  211.       END  (* View_File_Name > 0 *);
  212.  
  213.    IF View_File_Open THEN Close( ViewFile );
  214.  
  215.    Restore_Screen( Saved_Screen );
  216.    Reset_Global_Colors;
  217.  
  218. END   (* View_A_File *);
  219.  
  220. (*----------------------------------------------------------------------*)
  221. (*      View_Directory --- List files in current directory              *)
  222. (*----------------------------------------------------------------------*)
  223.  
  224. PROCEDURE View_Directory;
  225.  
  226. (*----------------------------------------------------------------------*)
  227. (*                                                                      *)
  228. (*     Procedure:  View_Directory                                       *)
  229. (*                                                                      *)
  230. (*     Purpose:    Lists files in current MSDOS directory               *)
  231. (*                                                                      *)
  232. (*     Calling Sequence:                                                *)
  233. (*                                                                      *)
  234. (*        View_Directory;                                               *)
  235. (*                                                                      *)
  236. (*     Calls:   View_Prompt                                             *)
  237. (*              Save_Screen                                             *)
  238. (*              Restore_Screen                                          *)
  239. (*              Draw_Menu_Frame                                         *)
  240. (*              Reset_Global_Colors                                     *)
  241. (*              Dir_Get_Default_Drive                                   *)
  242. (*              Dir_Get_Current_Path                                    *)
  243. (*              Dir_Find_First_File                                     *)
  244. (*              Dir_Find_Next_File                                      *)
  245. (*              Dir_Convert_Time                                        *)
  246. (*              Dir_Convert_Date                                        *)
  247. (*                                                                      *)
  248. (*----------------------------------------------------------------------*)
  249.  
  250. VAR
  251.    View_Directory_Name : AnyStr;
  252.    Drive_Ch            : CHAR;
  253.    Iok                 : INTEGER;
  254.    File_Entry          : Directory_Record;
  255.    S_File_Name         : STRING[14];
  256.    S_File_Time         : STRING[8];
  257.    S_File_Date         : STRING[8];
  258.    S_File_Size         : Real;
  259.    S_File_Xmodem_Time  : STRING[8];
  260.    Fs1                 : Real;
  261.    Fs2                 : Real;
  262.    I                   : INTEGER;
  263.    Dir_Spec            : AnyStr;
  264.  
  265. BEGIN (* View_Directory *)
  266.                                    (*  Draw view menu *)
  267.  
  268.    Save_Screen( Saved_Screen );
  269.    Draw_Menu_Frame( 5, 4, 75, 25, Menu_Frame_Color,
  270.                     Menu_Text_Color, 'View Current Directory' );
  271.  
  272.    WRITE('Enter search specification (*.* for all): ');
  273.    READLN( Dir_Spec );
  274.  
  275.    FOR I := 1 TO 3 DO
  276.       BEGIN
  277.          GoToXY( 1 , I );
  278.          ClrEol;
  279.       END;
  280.  
  281.    IF ( LENGTH( Dir_Spec ) <= 0 ) THEN
  282.       Dir_Spec := '*.*';
  283.  
  284.    RvsVideoOn( Menu_Text_Color , BackGround_Color );
  285.  
  286.    Drive_Ch := Dir_Get_Default_Drive;
  287.  
  288.    Iok := Dir_Get_Current_Path( Drive_Ch , View_Directory_Name );
  289.  
  290.    GoToXY( 1 , 1 );
  291.  
  292.    WRITELN('LISTING OF DIRECTORY: ',Drive_Ch + ':\' + View_Directory_Name );
  293.    WRITELN('      File Name     Size     Date     Time  Xfer Time');
  294.  
  295.    RvsVideoOff( Menu_Text_Color , BackGround_Color );
  296.  
  297.                                    (* RESET window so header doesn't vanish *)
  298.    Window( 7, 7, 74, 24 );
  299.    GoToXY( 1 , WhereY );
  300.  
  301.                                    (* List the directory contents   *)
  302.  
  303.    View_Count := 0;
  304.    View_Done  := ( Dir_Find_First_File( Dir_Spec, File_Entry ) <> 0 );
  305.  
  306.    WHILE( NOT View_Done ) DO
  307.       BEGIN
  308.                                    (* Display Next Directory Entry       *)
  309.          S_File_Name := '';
  310.          I           := 1;
  311.                                    (* Pick up file name *)
  312.  
  313.          WHILE( ( I <= 14 ) AND ( File_Entry.File_Name[I] <> CHR(0) ) ) DO
  314.             BEGIN
  315.                S_File_Name := S_File_Name + File_Entry.File_Name[I];
  316.                I           := I + 1;
  317.             END;
  318.                                    (* Pick up creation date and time *)
  319.  
  320.          Dir_Convert_Time( File_Entry.File_Time , S_File_Time );
  321.          Dir_Convert_Date( File_Entry.File_Date , S_File_Date );
  322.  
  323.                                    (* Pick up file size *)
  324.  
  325.          Fs1 := File_Entry.File_Size[1];
  326.          Fs2 := File_Entry.File_Size[2];
  327.  
  328.          IF Fs1 < 0 THEN Fs1 := Fs1 + 65536.0;
  329.          IF Fs2 < 0 THEN Fs2 := Fs2 + 65536.0;
  330.  
  331.          S_File_Size := Fs2 * 65536.0 + Fs1;
  332.  
  333.                                    (* Pick up transfer time *)
  334.  
  335.          S_File_Xmodem_Time := TimeString( ROUND( ( S_File_Size / 128.0 ) + 0.49 ) *
  336.                                          ( Trans_Time_Val / Baud_Rate ) );
  337.  
  338.                                    (* Display entry *)
  339.  
  340.          WRITELN( S_File_Name:14, ' ', S_File_Size:8:0, ' ', S_File_Date, ' ',
  341.                   S_File_Time,'   ',S_File_Xmodem_Time );
  342.  
  343.                                    (* Increment count of lines displayed *)
  344.  
  345.          View_Count := View_Count + 1;
  346.  
  347.                                    (* Prompt if end of screen *)
  348.          IF View_Count > 16 THEN
  349.             View_Prompt( View_Done , View_Count );
  350.  
  351.          View_Done := View_Done OR ( Dir_Find_Next_File( File_Entry ) <> 0 );
  352.  
  353.    END;
  354.                                    (* Issue final end-of-directory prompt *)
  355.  
  356.    RvsVideoOn( Menu_Text_Color , BackGround_Color );
  357.  
  358.    WRITE('Viewing of directory complete. ',
  359.          'Hit any key to continue.');
  360.  
  361.    RvsVideoOff( Menu_Text_Color , BackGround_Color );
  362.  
  363.    WHILE ( NOT KeyPressed ) DO ;
  364.  
  365.    READ( Kbd , View_Char );
  366.                                    (* Restore previous screen *)
  367.  
  368.    Restore_Screen( Saved_Screen );
  369.    Reset_Global_Colors;
  370.  
  371. END   (* View_Directory *);
  372.  
  373. (*----------------------------------------------------------------------*)
  374. (*      Log_Drive_Change --- Change current logged drive                *)
  375. (*----------------------------------------------------------------------*)
  376.  
  377. PROCEDURE Log_Drive_Change;
  378.  
  379. (*----------------------------------------------------------------------*)
  380. (*                                                                      *)
  381. (*     Procedure:  Log_Drive_Change                                     *)
  382. (*                                                                      *)
  383. (*     Purpose:    Change current logged drive                          *)
  384. (*                                                                      *)
  385. (*     Calling Sequence:                                                *)
  386. (*                                                                      *)
  387. (*        Log_Drive_Change                                              *)
  388. (*                                                                      *)
  389. (*     Calls:   Dir_Get_Default_Drive                                   *)
  390. (*              Dir_Set_Default_Drive                                   *)
  391. (*              Save_Screen                                             *)
  392. (*              Restore_Screen                                          *)
  393. (*              Draw_Menu_Frame                                         *)
  394. (*              Reset_Global_Colors                                     *)
  395. (*                                                                      *)
  396. (*                                                                      *)
  397. (*----------------------------------------------------------------------*)
  398.  
  399. VAR
  400.    Drive_Ch    : STRING[1];
  401.    Drive_No    : INTEGER;
  402.    Drive_Count : INTEGER;
  403.  
  404. BEGIN (* Log_Drive_Change *);
  405.  
  406.                                    (*  Draw log change menu *)
  407.  
  408.    Save_Screen( Saved_Screen );
  409.    Draw_Menu_Frame( 5, 10, 55, 15, Menu_Frame_Color,
  410.                     Menu_Text_Color, 'Change Current Logged Drive' );
  411.  
  412.    GoToXY( 1 , 1 );
  413.    Drive_Ch[1] := Dir_Get_Default_Drive;
  414.  
  415.    WRITELN('Current logged drive is ',Drive_Ch[1] );
  416.  
  417.    GoToXY( 1 , 2 );
  418.  
  419.    WRITE('Enter letter for new logged drive: ');
  420.  
  421.    READ( Kbd , Drive_Ch );
  422.    WRITE( Drive_Ch );
  423.  
  424.    IF LENGTH( Drive_Ch ) = 0 THEN
  425.       BEGIN
  426.          WRITELN;
  427.          WRITELN('*** Logged drive remains unchanged.')
  428.       END
  429.    ELSE
  430.       BEGIN
  431.                                 (* Figure no. of drives in system *)
  432.          Drive_Count := Dir_Count_Drives;
  433.  
  434.                                 (* Drive no. for entered letter   *)
  435.          Drive_No    := ORD( UpCASE( Drive_Ch ) ) - ORD( 'A' );
  436.  
  437.                                 (* Check if drive legitimate      *)
  438.  
  439.          IF ( Drive_No < 0 ) OR ( Drive_No > Drive_Count ) THEN
  440.             WRITELN('*** Invalid drive, logged drive unchanged.')
  441.          ELSE
  442.             BEGIN
  443.                                 (* Change default drive *)
  444.                Dir_Set_Default_Drive( Drive_Ch );
  445.  
  446.                WRITELN;
  447.                WRITELN('*** Logged drive changed to ',Drive_Ch );
  448.  
  449.             END;
  450.  
  451.       END;
  452.  
  453.    DELAY( Two_Second_Delay );
  454.  
  455.                                    (* Restore previous screen *)
  456.    Restore_Screen( Saved_Screen );
  457.    Reset_Global_Colors;
  458.  
  459. END   (* Log_Drive_Change *);
  460.  
  461. (*----------------------------------------------------------------------*)
  462. (*       Change_Subdirectory --- Change current disk subdirectory       *)
  463. (*----------------------------------------------------------------------*)
  464.  
  465. PROCEDURE Change_Subdirectory;
  466.  
  467. (*----------------------------------------------------------------------*)
  468. (*                                                                      *)
  469. (*     Procedure:  Change_Subdirectory                                  *)
  470. (*                                                                      *)
  471. (*     Purpose:    Change current subdirectory                          *)
  472. (*                                                                      *)
  473. (*     Calling Sequence:                                                *)
  474. (*                                                                      *)
  475. (*        Change_Subdirectory;                                          *)
  476. (*                                                                      *)
  477. (*     Calls:   Dir_Get_Default_Drive                                   *)
  478. (*              Dir_Set_Current_Path                                    *)
  479. (*              Dir_Get_Current_Path                                    *)
  480. (*              Save_Screen                                             *)
  481. (*              Restore_Screen                                          *)
  482. (*              Draw_Menu_Frame                                         *)
  483. (*              Reset_Global_Colors                                     *)
  484. (*                                                                      *)
  485. (*                                                                      *)
  486. (*----------------------------------------------------------------------*)
  487.  
  488. VAR
  489.    Path_Name : AnyStr;
  490.    Iok       : INTEGER;
  491.    Drive_Ch  : CHAR;
  492.  
  493. BEGIN (* Change_Subdirectory *)
  494.                                    (*  Draw directory change menu *)
  495.  
  496.    Save_Screen( Saved_Screen );
  497.    Draw_Menu_Frame( 5, 10, 60, 15, Menu_Frame_Color,
  498.                     Menu_Text_Color, 'Change Current Directory' );
  499.  
  500.    GoToXY( 1 , 1 );
  501.  
  502.    Drive_Ch := Dir_Get_Default_Drive;
  503.  
  504.    Iok := Dir_Get_Current_Path( Drive_Ch , Path_Name );
  505.  
  506.    WRITELN('Current directory is ', Drive_Ch + ':\' + Path_Name );
  507.  
  508.    WRITE('Enter name of new directory path: ');
  509.  
  510.    READ( Path_Name );
  511.    WRITELN;
  512.  
  513.    IF LENGTH( Path_Name ) = 0 THEN
  514.       WRITELN('*** Current directory remains unchanged.')
  515.    ELSE
  516.       BEGIN
  517.  
  518.          IF Dir_Set_Current_Path( Path_Name ) = 0 THEN
  519.             WRITELN('*** Current directory changed to ',
  520.                     Drive_Ch + ':' + Path_Name )
  521.          ELSE
  522.             WRITELN('*** Error found, directory not changed');
  523.       END;
  524.  
  525.    DELAY( Two_Second_Delay );
  526.  
  527.                                    (* Restore previous screen *)
  528.    Restore_Screen( Saved_Screen );
  529.    Reset_Global_Colors;
  530.  
  531. END   (* Change_Subdirectory *);
  532.  
  533. (*----------------------------------------------------------------------*)
  534. (*               Delete_A_File --- Delete a file                        *)
  535. (*----------------------------------------------------------------------*)
  536.  
  537. PROCEDURE Delete_A_File;
  538.  
  539. (*----------------------------------------------------------------------*)
  540. (*                                                                      *)
  541. (*     Procedure:  Delete_A_File                                        *)
  542. (*                                                                      *)
  543. (*     Purpose:    Delete file in current subdirectory                  *)
  544. (*                                                                      *)
  545. (*     Calling Sequence:                                                *)
  546. (*                                                                      *)
  547. (*        Delete_A_File;                                                *)
  548. (*                                                                      *)
  549. (*     Calls:   Dir_Delete_File                                         *)
  550. (*              Save_Screen                                             *)
  551. (*              Restore_Screen                                          *)
  552. (*              Draw_Menu_Frame                                         *)
  553. (*              Reset_Global_Colors                                     *)
  554. (*                                                                      *)
  555. (*----------------------------------------------------------------------*)
  556.  
  557. VAR
  558.    File_Name : AnyStr;
  559.  
  560. BEGIN (* Delete_A_File *)
  561.                                    (*  Draw delete file menu *)
  562.  
  563.    Save_Screen( Saved_Screen );
  564.    Draw_Menu_Frame( 5, 10, 60, 14, Menu_Frame_Color,
  565.                     Menu_Text_Color + Blink, 'Delete A File -- Be Careful!' );
  566.  
  567.    TextColor( Menu_Text_Color );
  568.  
  569.    GoToXY( 1 , 1 );
  570.  
  571.    WRITE('Enter name of file to delete: ');
  572.  
  573.    READ( File_Name );
  574.    WRITELN;
  575.  
  576.    IF LENGTH( File_Name ) = 0 THEN
  577.       WRITELN('*** No file to delete.')
  578.    ELSE
  579.       IF ( Dir_Delete_File( File_Name ) = 0 ) THEN
  580.          WRITELN('*** File deleted.')
  581.       ELSE
  582.          WRITELN('*** File not found to delete or read-only');
  583.  
  584.    DELAY( Two_Second_Delay );
  585.  
  586.                                    (* Restore previous screen *)
  587.    Restore_Screen( Saved_Screen );
  588.    Reset_Global_Colors;
  589.  
  590. END   (* Delete_A_File *);
  591.  
  592. (*----------------------------------------------------------------------*)
  593. (*        Find_Free_Space_On_Drive --- Find free space on a drive       *)
  594. (*----------------------------------------------------------------------*)
  595.  
  596. PROCEDURE Find_Free_Space_On_Drive;
  597.  
  598. (*----------------------------------------------------------------------*)
  599. (*                                                                      *)
  600. (*     Procedure:  Find_Free_Space_On_Drive                             *)
  601. (*                                                                      *)
  602. (*     Purpose:    Finds free space on a drive                          *)
  603. (*                                                                      *)
  604. (*     Calling Sequence:                                                *)
  605. (*                                                                      *)
  606. (*        Find_Free_Space_On_Drive;                                     *)
  607. (*                                                                      *)
  608. (*     Calls:   Dir_Get_Free_Space                                      *)
  609. (*              Save_Screen                                             *)
  610. (*              Restore_Screen                                          *)
  611. (*              Draw_Menu_Frame                                         *)
  612. (*              Reset_Global_Colors                                     *)
  613. (*                                                                      *)
  614. (*----------------------------------------------------------------------*)
  615.  
  616. VAR
  617.    Drive_Ch: CHAR;
  618.    Fspace:   REAL;
  619.  
  620. BEGIN (* Find_Free_Space_On_Drive *)
  621.  
  622.    Save_Screen( Saved_Screen );
  623.  
  624.    Draw_Menu_Frame( 10, 10, 61, 15, Menu_Frame_Color,
  625.                     Menu_Text_Color, 'Free space on drive' );
  626.  
  627.    REPEAT
  628.       GoToXY( 1 , 1 );
  629.       ClrEol;
  630.       Drive_CH := ' ';
  631.       WRITE('Which drive? ');
  632.       READ( Kbd , Drive_Ch );
  633.       WRITE( Drive_Ch );
  634.       Drive_Ch := UpCase( Drive_Ch );
  635.    UNTIL( Drive_Ch IN [' ','A'..'Z'] );
  636.  
  637.    IF Drive_Ch <> ' ' THEN
  638.       BEGIN
  639.          WRITELN;
  640.          FSpace := Dir_Get_Free_Space( Drive_Ch );
  641.          IF Fspace > 0.0 THEN
  642.             WRITELN('Free space on drive ',Drive_Ch,' is ',Fspace:8:0,' bytes')
  643.          ELSE
  644.             WRITELN('Can''t find free space for drive ',Drive_Ch);
  645.       END;
  646.  
  647.    WRITELN(' ');
  648.    WRITE  ('Hit any key to continue');
  649.  
  650.    READ( Kbd, Drive_Ch );
  651.  
  652.    IF ( Drive_Ch = CHR( ESC ) ) AND KeyPressed THEN
  653.       READ( Kbd, Drive_Ch );
  654.  
  655.    Restore_Screen( Saved_Screen );
  656.  
  657.    Reset_Global_Colors;
  658.  
  659. END   (* Find_Free_Space_On_Drive *);
  660.  
  661. (*----------------------------------------------------------------------*)
  662. (*                    Copy_A_File  --- Copy a file                      *)
  663. (*----------------------------------------------------------------------*)
  664.  
  665. PROCEDURE Copy_A_File;
  666.  
  667. (*----------------------------------------------------------------------*)
  668. (*                                                                      *)
  669. (*     Procedure:  Copy_A_File                                          *)
  670. (*                                                                      *)
  671. (*     Purpose:    Copies a file                                        *)
  672. (*                                                                      *)
  673. (*     Calling Sequence:                                                *)
  674. (*                                                                      *)
  675. (*        Copy_A_File;                                                  *)
  676. (*                                                                      *)
  677. (*     Calls:                                                           *)
  678. (*              Save_Screen                                             *)
  679. (*              Restore_Screen                                          *)
  680. (*              Draw_Menu_Frame                                         *)
  681. (*              Reset_Global_Colors                                     *)
  682. (*              Open_File_Handle                                        *)
  683. (*              Create_File_Handle                                      *)
  684. (*              Close_File_Handle                                       *)
  685. (*              Read_File_Handle                                        *)
  686. (*              Write_File_Handle                                       *)
  687. (*                                                                      *)
  688. (*----------------------------------------------------------------------*)
  689.  
  690. CONST
  691.    BufSize =  4096                 (* Buffer size       *);
  692.  
  693. VAR
  694.    F_Handle   : INTEGER            (* File to be copied *);
  695.    F_Size     : REAL               (* Size of file      *);
  696.    F_Open     : BOOLEAN            (* If F opened OK    *);
  697.    G_Handle   : INTEGER            (* File copied to    *);
  698.    G_Open     : BOOLEAN            (* If G opened OK    *);
  699.    G_Size     : REAL               (* Size of G         *);
  700.    F_Name     : AnyStr             (* Input file name   *);
  701.    G_Name     : AnyStr             (* Output file name  *);
  702.    Abort_Copy : BOOLEAN            (* TRUE to stop copy *);
  703.  
  704.    BytesRead  : INTEGER            (* # of bytes read   *);
  705.    BytesDone  : REAL               (* Total bytes read  *);
  706.  
  707.                                    (* Buffer area       *)
  708.    Buffer     : PACKED ARRAY[ 1 .. BufSize ] OF CHAR;
  709.  
  710.    Err        : INTEGER            (* I/O error flag    *);
  711.  
  712. LABEL  Abort_it;
  713.  
  714. BEGIN (* Copy_A_File *)
  715.                                    (* Announce file copy *)
  716.    Save_Screen( Saved_Screen );
  717.  
  718.    Draw_Menu_Frame( 5, 10, 75, 17, Menu_Frame_Color,
  719.                     Menu_Text_Color, 'Copy a file' );
  720.  
  721.    Abort_Copy := FALSE;
  722.                                    (* Get name of file to copy *)
  723.    REPEAT
  724.  
  725.       GoToXY( 1 , 1 );
  726.       WRITE(' Enter file to be copied:    ');
  727.       ClrEol;
  728.       READLN( F_Name );
  729.  
  730.       IF LENGTH( F_Name ) > 0 THEN
  731.          F_Size := Get_File_Size( F_Name, F_Open )
  732.       ELSE
  733.          Abort_Copy := TRUE;
  734.  
  735.    UNTIL ( F_Open OR Abort_Copy );
  736.  
  737.                                    (* Stop if no input file *)
  738.    IF Abort_Copy THEN GOTO Abort_It;
  739.  
  740.                                    (* Get name of file to copy to *)
  741.    REPEAT
  742.  
  743.       GoToXY( 1 , 2 );
  744.       WRITE(' Enter file to receive copy: ');
  745.       ClrEol;
  746.       READLN( G_Name );
  747.  
  748.       IF LENGTH( G_Name ) > 0 THEN
  749.          G_Size := Get_File_Size( G_Name, G_Open )
  750.       ELSE
  751.          Abort_Copy := TRUE;
  752.  
  753.       IF G_Open THEN
  754.          BEGIN
  755.             GoToXY( 1 , 3 );
  756.             G_Open := NOT YesNo(' File already exists, overwrite (Y or N)? ');
  757.          END;
  758.  
  759.    UNTIL ( ( NOT G_Open ) OR Abort_Copy );
  760.  
  761.                                    (* Open input file *)
  762.  
  763.    Err := Open_File_Handle( F_Name, Access_Read_Mode, F_Handle );
  764.  
  765.                                    (* Open output file *)
  766.  
  767.    Err := Create_File_Handle( G_Name , Attribute_None , G_Handle );
  768.  
  769.                                    (* Report file size *)
  770.    GoToXY( 1 , 4 );
  771.    WRITE('Size of file ',F_Name,' in bytes is ',F_Size:8:0 );
  772.  
  773.    GoToXY( 1 , 5 );
  774.    WRITE('Bytes copied: ');
  775.  
  776.    BytesDone := 0.0;
  777.                                    (* Perform the copy *)
  778.    REPEAT
  779.  
  780.       BytesRead := BufSize;
  781.  
  782.       Err := Read_File_Handle( F_Handle, Buffer, BytesRead );
  783.  
  784.       IF BytesRead > 0 THEN
  785.          Err := Write_File_Handle( G_Handle, Buffer, BytesRead );
  786.  
  787.       BytesDone := BytesDone + BytesRead;
  788.  
  789.       GoToXY( 15 , 5 );
  790.       WRITE( BytesDone:8:0 );
  791.  
  792.    UNTIL ( BytesRead < BufSize );
  793.  
  794.                                    (* Close files  *)
  795.    Err := Close_File_Handle( F_Handle );
  796.    Err := Close_File_Handle( G_Handle );
  797.  
  798.    GoToXY( 1 , 6 );
  799.    WRITE('Copy complete.');
  800.    DELAY( Two_Second_Delay );
  801.  
  802. Abort_It:
  803.                                    (* Restore previous screen *)
  804.    Restore_Screen( Saved_Screen );
  805.  
  806.    Reset_Global_Colors;
  807.  
  808. END   (* Copy_A_File *);
  809.  
  810. (*----------------------------------------------------------------------*)
  811.  
  812. BEGIN (* PibFileManipulation *)
  813.  
  814.    File_Menu.Menu_Size    := 8;
  815.    File_Menu.Menu_Row     := 11;
  816.    File_Menu.Menu_Column  := 30;
  817.    File_Menu.Menu_Tcolor  := Menu_Text_Color;
  818.    File_Menu.Menu_Bcolor  := BackGround_Color;
  819.    File_Menu.Menu_Fcolor  := Menu_Frame_Color;
  820.    File_Menu.Menu_Width   := 0;
  821.    File_Menu.Menu_Height  := 0;
  822.  
  823.    File_Menu.Menu_Default := 8;
  824.  
  825.    FOR I := 1 TO 8 DO
  826.       WITH File_Menu.Menu_Entries[I] DO
  827.       BEGIN
  828.          Menu_Item_Row    := I;
  829.          Menu_Item_Column := 2;
  830.          CASE I Of
  831.             1:  Menu_Item_Text := 'A)ctive directory change';
  832.             2:  Menu_Item_Text := 'C)opy file';
  833.             3:  Menu_Item_Text := 'D)irectory display';
  834.             4:  Menu_Item_Text := 'E)rase file';
  835.             5:  Menu_Item_Text := 'F)ree space on drive';
  836.             6:  Menu_Item_Text := 'L)ogged drive change';
  837.             7:  Menu_Item_Text := 'V)iew a file';
  838.             8:  Menu_Item_Text := 'Q)uit';
  839.          END (* CASE *);
  840.       END;
  841.  
  842.    File_Menu.Menu_Title := 'Choose File Function: ';
  843.  
  844.    Menu_Display_Choices( File_Menu );
  845.  
  846.    CASE Menu_Get_Choice( File_Menu , Erase_Menu ) OF
  847.       1:  Change_Subdirectory;
  848.       2:  Copy_A_File;
  849.       3:  View_Directory;
  850.       4:  Delete_A_File;
  851.       5:  Find_Free_Space_On_Drive;
  852.       6:  Log_Drive_Change;
  853.       7:  View_A_File;
  854.       ELSE;
  855.    END (* Case *);
  856.  
  857. END   (* PibFileManipulation *);